indiv smooths
Megan Lott
10/14/2020
Load all required libraries.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages ------------------------------------------------------------------------ tidyverse 1.3.0 --## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.0
## v tidyr 1.1.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'dplyr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts --------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 3.6.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)## Warning: package 'broom' was built under R version 3.6.3Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.## Warning: Ignoring 1 observations p2## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 268)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 12.85120 12.85698 12.86272 12.86838 12.87398 12.87949 12.88492 12.89026
## [9] 12.89549 12.90061 12.90562 12.91050 12.91525 12.91985 12.92431 12.92861
## [17] 12.93275 12.93672 12.94050 12.94411 12.94751 12.95072 12.95373 12.95656
## [25] 12.95922 12.96172 12.96406 12.96625 12.96831 12.97022 12.97202 12.97369
## [33] 12.97525 12.97671 12.97807 12.97934 12.98053 12.98164 12.98268 12.98367
## [41] 12.98460 12.98548 12.98633 12.98706 12.98760 12.98795 12.98812 12.98813
## [49] 12.98799 12.98769 12.98725 12.98667 12.98597 12.98516 12.98424 12.98322
## [57] 12.98211 12.98092 12.97966 12.97833 12.97695 12.97552 12.97405 12.97255
## [65] 12.97103 12.96950 12.96796 12.96643 12.96491 12.96341 12.96194 12.96018
## [73] 12.95782 12.95492 12.95153 12.94769 12.94346 12.93889 12.93403 12.92893
## [81] 12.92364 12.91821 12.91269 12.90713 12.90159 12.89611 12.89075 12.88555
## [89] 12.88057 12.87585 12.87145 12.86742 12.86285 12.85688 12.84963 12.84122
## [97] 12.83176 12.82139 12.81020 12.79833 12.78590 12.77301 12.75980 12.74637
## [105] 12.73285 12.71936 12.70601 12.69292 12.68022 12.66802 12.65644 12.64560
## [113] 12.63561 12.62660 12.61869 12.61199 12.60663 12.60271 12.60037 12.59971
## [121] 12.60082 12.60356 12.60775 12.61322 12.61978 12.62726 12.63546 12.64422
## [129] 12.65335 12.66266 12.67199 12.68115 12.68996 12.69824 12.70580 12.71364
## [137] 12.72273 12.73290 12.74400 12.75584 12.76827 12.78110 12.79418 12.80734
## [145] 12.82039 12.83319 12.84555 12.85731 12.86830 12.87883 12.88934 12.89984
## [153] 12.91035 12.92090 12.93150 12.94217 12.95292 12.96378 12.97477 12.98590
## [161] 12.99719 13.01158 13.03138 13.05570 13.08361 13.11423 13.14664 13.17993
## [169] 13.21321 13.24556 13.27608 13.30386 13.32800 13.34759 13.36173 13.37373
## [177] 13.38733 13.40227 13.41831 13.43518 13.45263 13.47041 13.48826 13.50593
## [185] 13.52316 13.53970 13.55528 13.56967 13.58259 13.59381 13.60305 13.61008
## [193] 13.61462 13.61643 13.61526 13.61084 13.60294 13.59176 13.57771 13.56121
## [201] 13.54266 13.52247 13.50106 13.47884 13.45622 13.43361 13.41142 13.39007
## [209] 13.36995 13.35150 13.33284 13.31213 13.28978 13.26621 13.24181 13.21700
## [217] 13.19220 13.16782 13.14426 13.12064 13.09589 13.07008 13.04331 13.01568
## [225] 12.98728 12.95820 12.92853 12.89837 12.86780 12.83693 12.80585 12.77465
## [233] 12.74341 12.71167 12.67894 12.64532 12.61092 12.57582 12.54012 12.50392
## [241] 12.46732 12.43042 12.39331 12.35608 12.31885 12.28140 12.24350 12.20513
## [249] 12.16632 12.12706 12.08736 12.04723 12.00668 11.96570 11.92432 11.88252
## [257] 11.84033 11.79774 11.75477 11.71164 11.66851 11.62529 11.58189 11.53822
## [265] 11.49418 11.44968 11.40462 11.35891#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 268)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.52181 12.52244 12.52308 12.52371 12.52435 12.52500 12.52565 12.52632
## [9] 12.52700 12.52769 12.52840 12.52914 12.52990 12.53068 12.53149 12.53234
## [17] 12.53321 12.53412 12.53507 12.53606 12.53709 12.53816 12.53926 12.54035
## [25] 12.54143 12.54251 12.54359 12.54466 12.54573 12.54680 12.54786 12.54891
## [33] 12.54997 12.55102 12.55207 12.55311 12.55416 12.55520 12.55624 12.55727
## [41] 12.55831 12.55934 12.56038 12.56141 12.56244 12.56347 12.56450 12.56553
## [49] 12.56656 12.56759 12.56861 12.56961 12.57059 12.57156 12.57253 12.57348
## [57] 12.57444 12.57539 12.57634 12.57731 12.57828 12.57926 12.58026 12.58127
## [65] 12.58231 12.58337 12.58446 12.58558 12.58673 12.58792 12.58914 12.59042
## [73] 12.59173 12.59310 12.59451 12.59598 12.59751 12.59910 12.60066 12.60209
## [81] 12.60342 12.60465 12.60580 12.60689 12.60792 12.60891 12.60988 12.61084
## [89] 12.61181 12.61279 12.61380 12.61486 12.61598 12.61717 12.61845 12.61983
## [97] 12.62132 12.62295 12.62472 12.62561 12.62469 12.62212 12.61805 12.61264
## [105] 12.60604 12.59841 12.58990 12.58067 12.57087 12.56066 12.55019 12.53962
## [113] 12.52911 12.51880 12.50886 12.49943 12.49068 12.48276 12.47582 12.47002
## [121] 12.46551 12.46245 12.46100 12.46130 12.46352 12.46781 12.47505 12.48549
## [129] 12.49836 12.51288 12.52826 12.54372 12.55848 12.57177 12.58279 12.59432
## [137] 12.60931 12.62725 12.64763 12.66993 12.69365 12.71828 12.74330 12.76821
## [145] 12.79249 12.81564 12.83714 12.85649 12.87316 12.89030 12.91091 12.93429
## [153] 12.95976 12.98661 13.01415 13.04169 13.06853 13.09397 13.11733 13.13791
## [161] 13.15501 13.17176 13.19139 13.21334 13.23706 13.26199 13.28758 13.31327
## [169] 13.33851 13.36274 13.38541 13.40595 13.42383 13.43848 13.44934 13.45812
## [177] 13.46682 13.47536 13.48365 13.49159 13.49910 13.50610 13.51249 13.51818
## [185] 13.52308 13.52712 13.53019 13.53221 13.53310 13.53275 13.53109 13.52803
## [193] 13.52347 13.51733 13.50953 13.49996 13.48793 13.47304 13.45565 13.43611
## [201] 13.41479 13.39205 13.36824 13.34373 13.31887 13.29403 13.26957 13.24584
## [209] 13.22320 13.20203 13.17982 13.15441 13.12658 13.09715 13.06690 13.03665
## [217] 13.00718 12.97931 12.95382 12.92921 12.90348 12.87676 12.84919 12.82090
## [225] 12.79200 12.76263 12.73292 12.70299 12.67298 12.64300 12.61319 12.58368
## [233] 12.55459 12.52542 12.49562 12.46526 12.43441 12.40313 12.37151 12.33960
## [241] 12.30748 12.27521 12.24287 12.21053 12.17824 12.14589 12.11327 12.08040
## [249] 12.04729 12.01393 11.98034 11.94653 11.91248 11.87823 11.84375 11.80907
## [257] 11.77420 11.73912 11.70386 11.66867 11.63374 11.59897 11.56426 11.52950
## [265] 11.49459 11.45942 11.42390 11.38792#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 268)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 11.62514 11.64108 11.65686 11.67247 11.68790 11.70312 11.71814 11.73292
## [9] 11.74747 11.76175 11.77577 11.78951 11.80295 11.81608 11.82888 11.84135
## [17] 11.85346 11.86521 11.87657 11.88754 11.89811 11.90825 11.91795 11.92720
## [25] 11.93599 11.94430 11.95212 11.95943 11.96622 11.97248 11.97822 11.98346
## [33] 11.98824 11.99258 11.99651 12.00005 12.00323 12.00608 12.00862 12.01088
## [41] 12.01289 12.01468 12.01627 12.01769 12.01896 12.02011 12.02117 12.02217
## [49] 12.02313 12.02408 12.02451 12.02392 12.02237 12.01994 12.01668 12.01265
## [57] 12.00793 12.00256 11.99662 11.99016 11.98326 11.97597 11.96835 11.96048
## [65] 11.95240 11.94419 11.93591 11.92762 11.91938 11.91126 11.90332 11.89561
## [73] 11.88822 11.88119 11.87459 11.86849 11.86294 11.85801 11.85199 11.84330
## [81] 11.83225 11.81911 11.80418 11.78773 11.77005 11.75144 11.73217 11.71254
## [89] 11.69283 11.67332 11.65431 11.63608 11.61891 11.60310 11.58892 11.57667
## [97] 11.56664 11.55910 11.55435 11.55086 11.54698 11.54279 11.53836 11.53378
## [105] 11.52912 11.52446 11.51989 11.51548 11.51130 11.50744 11.50398 11.50100
## [113] 11.49857 11.49678 11.49569 11.49540 11.49598 11.49751 11.50006 11.50373
## [121] 11.50858 11.51469 11.52215 11.53103 11.54141 11.55337 11.56932 11.59071
## [129] 11.61622 11.64452 11.67427 11.70414 11.73280 11.75893 11.78118 11.80373
## [137] 11.83110 11.86254 11.89730 11.93463 11.97377 12.01396 12.05446 12.09451
## [145] 12.13336 12.17024 12.20442 12.23512 12.26160 12.28722 12.31543 12.34569
## [153] 12.37742 12.41007 12.44306 12.47583 12.50783 12.53848 12.56721 12.59348
## [161] 12.61670 12.63894 12.66241 12.68682 12.71187 12.73726 12.76270 12.78788
## [169] 12.81251 12.83629 12.85892 12.88010 12.89953 12.91693 12.93198 12.94575
## [177] 12.95943 12.97296 12.98624 12.99919 13.01174 13.02379 13.03526 13.04608
## [185] 13.05615 13.06540 13.07375 13.08111 13.08740 13.09254 13.09644 13.09902
## [193] 13.10020 13.09990 13.09803 13.09452 13.08966 13.08382 13.07698 13.06913
## [201] 13.06026 13.05037 13.03943 13.02744 13.01439 13.00027 12.98507 12.96877
## [209] 12.95137 12.93285 12.91331 12.89284 12.87143 12.84904 12.82565 12.80125
## [217] 12.77580 12.74930 12.72171 12.69304 12.66334 12.63260 12.60085 12.56809
## [225] 12.53433 12.49960 12.46388 12.42721 12.38959 12.35103 12.31154 12.27113
## [233] 12.22982 12.18761 12.14450 12.10047 12.05550 12.00958 11.96270 11.91484
## [241] 11.86599 11.81612 11.76524 11.71332 11.66034 11.60635 11.55138 11.49544
## [249] 11.43852 11.38061 11.32171 11.26183 11.20095 11.13908 11.07621 11.01233
## [257] 10.94745 10.88157 10.81467 10.74673 10.67773 10.60769 10.53663 10.46454
## [265] 10.39146 10.31739 10.24235 10.16634#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")